

(defun dist (row1 row2)
    (sqrt (sum (** (- row1 row2) 2))))


(defun quick-cluster (matrixdata numclusters &optional plot)
  
  (setf initial-means (initial-cluster-centers matrixdata numclusters))
  (setf initial-means     (update-initial-cluster-centers matrixdata initial-means))
  (setf cluster-membership (assign-cases-to-nearest-cluster matrixdata initial-means plot))
  #|(when plot 
        (setf colors (list 'green 'red 'blue 'orange 'grey 'brown 'cyan 'yellow 'magenta 'violet 'light-blue 'pink 'dark-red 'BLACK 'DARK-GREEN ))
        (send plot :point-color (iseq (length cluster-membership))
              (mapcar #'(lambda (c) (select colors c)) cluster-membership))
        (send plot :point-label (iseq (length cluster-membership))
              (mapcar #'(lambda (c) (princ-to-string c)) cluster-membership))
              (send plot :redraw))|#

        cluster-membership
)



(defun update-initial-cluster-centers (matrixdata initial-means)
  (let* ((matrixdata matrixdata)
         (initial-centers initial-means)
         (close-cluster)
         (cluster-group)
         )
    (dotimes (i (array-dimension matrixdata '0))
             (setf close-cluster (first (closer-mean-to-row (row matrixdata i) initial-centers)))
             (push close-cluster cluster-group )
             (setf (select initial-centers close-cluster) 
                  (/ (+ (* (+ 1 i) (select initial-centers close-cluster))
                                 (row matrixdata i)) (+ 2 i)))
             )
    initial-centers))


(defun assign-cases-to-nearest-cluster (matrixdata initial-means &optional plot)
  (let* ((matrixdata matrixdata)
         (initial-centers initial-means)
         (close-cluster)
         (cluster-group)
         (plot plot)
         
         )
    (dotimes (i (array-dimension matrixdata '0))
             (setf close-cluster (first (closer-mean-to-row (row matrixdata i) initial-centers)))
             (push close-cluster cluster-group)
             (when plot 
                   (setf colors (list 'green 'red 'blue 'orange 'grey 'brown 'cyan 'yellow 'magenta 'violet 'light-blue 'pink 'dark-red 'BLACK 'DARK-GREEN ))
                   (send plot :point-color i
                         (select colors close-cluster))
                   (send plot :redraw))
             )
    (reverse cluster-group)))
             

(defun closer-means (means-list)
  (let* ((initial-means means-list)
         (closer-means (list 0 1))
         (min-dist (dist (select initial-means (first closer-means))
                         (select initial-means (second closer-means))))
         (curr-dist)
         (numclusters (length means-list))
         )
    (dotimes (i numclusters)
             (dotimes (j numclusters)
                      (when (< j i)
                          (setf curr-dist (dist (select initial-means i)
                                                (select initial-means j)))
                          (when (> min-dist curr-dist)
                                (setf closer-means (list i j))
                                (setf min-dist curr-dist)))))
    (list min-dist closer-means)))

(defun closer-mean-to-row (row means-list)
  (let* ((row row)
         (means-list means-list)
         (distances (mapcar #'(lambda (m) (dist row m)) means-list))
         (min-dis (min distances))
         (second-min-dist (second (sort-data distances)))
         (closer-mean-to-row (which (mapcar #'(lambda (m) (= m min-dis)) distances)))
         (second-closer-mean-to-row (which (mapcar #'(lambda (m) (= m second-min-dist)) distances)))
         )
    (combine (list closer-mean-to-row second-closer-mean-to-row))))
    

(defun initial-cluster-centers (matrixdata numclusters &optional initial-centers)
  (let* (
         (matrixdata matrixdata)
         (numclusters numclusters)
         (initial-means (if (not initial-centers) (mapcar #'(lambda (nc) (coerce 
                                                (repeat '0 (array-dimension matrixdata '1))
                                                'vector))
                                    (iseq numclusters))
                            initial-centers))
         (closer-means)
         )
    (dotimes (i (array-dimension matrixdata '0))
             (setf closer-means (closer-means initial-means))
             (setf closer-means-to-row (closer-mean-to-row 
                                          (row matrixdata i)
                                          initial-means))
             
             (cond ((> (min (mapcar #'(lambda (initial-mean) 
                                        (dist (row matrixdata i) initial-mean))
                                    initial-means))
                       (first closer-means))
                    (if (> (dist (row matrixdata i)
                                 (select initial-means (first (second closer-means)))))
                        (setf (select initial-means (first (second closer-means)))
                              (row matrixdata i))
                        (setf (select initial-means (second (second closer-means)))
                              (row matrixdata i))))
               ((> (dist (row matrixdata i) 
                         (select initial-means
                                 (second closer-means-to-row)))
                   (min (mapcar #'(lambda (m) (dist m (select initial-means 
                                                                (first closer-means-to-row))))
                                         initial-means)))
                                                     
                (setf (select initial-means (first closer-means-to-row)) (row matrixdata i)))))
    initial-means))


